indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'tidyr' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 345)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.02897 13.02545 13.02201 13.01865 13.01537 13.01215 13.00899 13.00589
## [9] 13.00284 12.99983 12.99686 12.99392 12.99101 12.98812 12.98525 12.98238
## [17] 12.97952 12.97665 12.97378 12.97090 12.96799 12.96506 12.96210 12.95910
## [25] 12.95606 12.95297 12.94982 12.94662 12.94335 12.94003 12.93668 12.93331
## [33] 12.92992 12.92651 12.92308 12.91965 12.91622 12.91279 12.90936 12.90594
## [41] 12.90253 12.89914 12.89578 12.89243 12.88912 12.88584 12.88260 12.87940
## [49] 12.87624 12.87314 12.87009 12.86710 12.86417 12.86131 12.85852 12.85580
## [57] 12.85316 12.85061 12.84814 12.84577 12.84349 12.84131 12.83924 12.83728
## [65] 12.83532 12.83328 12.83116 12.82898 12.82674 12.82445 12.82212 12.81975
## [73] 12.81736 12.81496 12.81255 12.81015 12.80775 12.80538 12.80303 12.80073
## [81] 12.79846 12.79626 12.79412 12.79205 12.79006 12.78817 12.78637 12.78468
## [89] 12.78311 12.78166 12.78035 12.77918 12.77816 12.77730 12.77661 12.77610
## [97] 12.77577 12.77564 12.77572 12.77579 12.77565 12.77533 12.77483 12.77418
## [105] 12.77341 12.77251 12.77152 12.77046 12.76934 12.76818 12.76700 12.76582
## [113] 12.76465 12.76352 12.76245 12.76145 12.76054 12.75975 12.75908 12.75856
## [121] 12.75821 12.75804 12.75808 12.75834 12.75885 12.75961 12.76066 12.76200
## [129] 12.76366 12.76566 12.76801 12.77073 12.77385 12.77840 12.78521 12.79398
## [137] 12.80441 12.81621 12.82906 12.84268 12.85676 12.87101 12.88511 12.89877
## [145] 12.91170 12.92358 12.93413 12.94304 12.95001 12.95728 12.96708 12.97913
## [153] 12.99311 13.00873 13.02568 13.04367 13.06239 13.08154 13.10083 13.11995
## [161] 13.13859 13.15647 13.17328 13.18871 13.20247 13.21426 13.22378 13.23072
## [169] 13.23639 13.24230 13.24840 13.25465 13.26104 13.26751 13.27405 13.28061
## [177] 13.28715 13.29366 13.30009 13.30640 13.31257 13.31856 13.32434 13.32987
## [185] 13.33512 13.34005 13.34464 13.34884 13.35263 13.35596 13.35881 13.36114
## [193] 13.36293 13.36412 13.36469 13.36461 13.36385 13.36236 13.36011 13.35707
## [201] 13.35322 13.34850 13.34289 13.33636 13.32887 13.32038 13.31087 13.30030
## [209] 13.28863 13.27583 13.26044 13.24132 13.21896 13.19382 13.16638 13.13711
## [217] 13.10648 13.07498 13.04307 13.01123 12.97993 12.94965 12.92086 12.89404
## [225] 12.86965 12.84817 12.82632 12.80076 12.77193 12.74028 12.70624 12.67025
## [233] 12.63276 12.59419 12.55500 12.51562 12.47648 12.43803 12.40071 12.36496
## [241] 12.33121 12.29990 12.27148 12.24638 12.22504 12.20608 12.18779 12.17014
## [249] 12.15307 12.13655 12.12053 12.10499 12.08986 12.07511 12.06071 12.04660
## [257] 12.03275 12.01912 12.00565 11.99232 11.97908 11.96692 11.95672 11.94826
## [265] 11.94134 11.93575 11.93126 11.92767 11.92477 11.92234 11.92018 11.91806
## [273] 11.91578 11.91313 11.90989 11.90586 11.90081 11.89454 11.88684 11.87749
## [281] 11.86745 11.85779 11.84849 11.83950 11.83078 11.82231 11.81404 11.80594
## [289] 11.79798 11.79011 11.78230 11.77451 11.76671 11.75886 11.75093 11.74288
## [297] 11.73492 11.72728 11.71995 11.71288 11.70606 11.69946 11.69306 11.68682
## [305] 11.68074 11.67477 11.66890 11.66310 11.65734 11.65160 11.64586 11.64009
## [313] 11.63426 11.62835 11.62233 11.61626 11.61023 11.60422 11.59824 11.59229
## [321] 11.58637 11.58049 11.57464 11.56883 11.56305 11.55732 11.55163 11.54597
## [329] 11.54037 11.53480 11.52928 11.52381 11.51839 11.51302 11.50770 11.50243
## [337] 11.49722 11.49206 11.48696 11.48191 11.47693 11.47200 11.46714 11.46235
## [345] 11.45761#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 345)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.63190 12.62703 12.62228 12.61765 12.61313 12.60871 12.60440 12.60020
## [9] 12.59609 12.59207 12.58815 12.58432 12.58057 12.57690 12.57331 12.56980
## [17] 12.56636 12.56299 12.55968 12.55644 12.55325 12.55012 12.54704 12.54401
## [25] 12.54103 12.53808 12.53518 12.53231 12.52948 12.52668 12.52392 12.52120
## [33] 12.51853 12.51592 12.51335 12.51085 12.50840 12.50601 12.50369 12.50144
## [41] 12.49926 12.49715 12.49512 12.49317 12.49130 12.48952 12.48782 12.48622
## [49] 12.48471 12.48330 12.48198 12.48077 12.47967 12.47868 12.47779 12.47702
## [57] 12.47637 12.47584 12.47544 12.47516 12.47500 12.47499 12.47510 12.47535
## [65] 12.47573 12.47621 12.47680 12.47749 12.47829 12.47919 12.48020 12.48131
## [73] 12.48253 12.48386 12.48529 12.48683 12.48847 12.49022 12.49207 12.49404
## [81] 12.49611 12.49828 12.50056 12.50295 12.50545 12.50805 12.51076 12.51358
## [89] 12.51650 12.51953 12.52267 12.52592 12.52927 12.53274 12.53631 12.53999
## [97] 12.54377 12.54767 12.55167 12.55580 12.56008 12.56450 12.56905 12.57372
## [105] 12.57851 12.58342 12.58843 12.59353 12.59873 12.60401 12.60936 12.61479
## [113] 12.62028 12.62582 12.63141 12.63704 12.64270 12.64840 12.65411 12.65983
## [121] 12.66556 12.67130 12.67702 12.68273 12.68841 12.69407 12.69969 12.70527
## [129] 12.71134 12.71837 12.72625 12.73488 12.74415 12.75394 12.76416 12.77469
## [137] 12.78543 12.79626 12.80709 12.81779 12.82828 12.83843 12.84813 12.85729
## [145] 12.86580 12.87353 12.88040 12.88870 12.90050 12.91529 12.93258 12.95188
## [153] 12.97269 12.99451 13.01685 13.03922 13.06111 13.08204 13.10151 13.11903
## [161] 13.13409 13.14621 13.15488 13.16247 13.17156 13.18198 13.19359 13.20623
## [169] 13.21973 13.23394 13.24871 13.26386 13.27926 13.29473 13.31012 13.32528
## [177] 13.34004 13.35425 13.36775 13.38038 13.39198 13.40240 13.41149 13.41907
## [185] 13.42499 13.42911 13.43125 13.43126 13.42898 13.42448 13.41801 13.40972
## [193] 13.39976 13.38828 13.37541 13.36131 13.34613 13.33001 13.31309 13.29553
## [201] 13.27747 13.25905 13.24043 13.22174 13.20314 13.18478 13.16679 13.14933
## [209] 13.13254 13.11656 13.09857 13.07603 13.04957 13.01982 12.98741 12.95296
## [217] 12.91711 12.88047 12.84367 12.80735 12.77212 12.73863 12.70748 12.67931
## [225] 12.65475 12.63443 12.61512 12.59340 12.56957 12.54393 12.51679 12.48847
## [233] 12.45925 12.42945 12.39937 12.36931 12.33959 12.31051 12.28237 12.25547
## [241] 12.23013 12.20664 12.18532 12.16646 12.15038 12.13658 12.12425 12.11325
## [249] 12.10342 12.09459 12.08661 12.07934 12.07260 12.06624 12.06012 12.05406
## [257] 12.04791 12.04153 12.03474 12.02740 12.01935 12.01215 12.00730 12.00452
## [265] 12.00355 12.00410 12.00590 12.00869 12.01217 12.01609 12.02017 12.02413
## [273] 12.02770 12.03060 12.03257 12.03333 12.03260 12.03011 12.02559 12.01876
## [281] 12.01107 12.00411 11.99774 11.99188 11.98640 11.98121 11.97619 11.97124
## [289] 11.96625 11.96111 11.95572 11.94997 11.94374 11.93694 11.92945 11.92117
## [297] 11.91259 11.90426 11.89613 11.88817 11.88033 11.87257 11.86486 11.85715
## [305] 11.84940 11.84158 11.83364 11.82554 11.81724 11.80871 11.79990 11.79077
## [313] 11.78128 11.77139 11.76107 11.75039 11.73947 11.72832 11.71693 11.70532
## [321] 11.69348 11.68142 11.66914 11.65665 11.64396 11.63106 11.61796 11.60466
## [329] 11.59118 11.57750 11.56364 11.54960 11.53539 11.52100 11.50645 11.49173
## [337] 11.47685 11.46182 11.44664 11.43130 11.41583 11.40022 11.38447 11.36859
## [345] 11.35258#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 345)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.03047 12.02519 12.02003 12.01500 12.01009 12.00529 12.00059 11.99599
## [9] 11.99149 11.98708 11.98275 11.97849 11.97431 11.97019 11.96613 11.96212
## [17] 11.95816 11.95424 11.95035 11.94650 11.94266 11.93884 11.93504 11.93124
## [25] 11.92743 11.92363 11.91980 11.91596 11.91210 11.90820 11.90427 11.90030
## [33] 11.89628 11.89220 11.88806 11.88386 11.87962 11.87537 11.87111 11.86686
## [41] 11.86262 11.85839 11.85418 11.85000 11.84585 11.84173 11.83766 11.83364
## [49] 11.82967 11.82576 11.82191 11.81814 11.81444 11.81082 11.80729 11.80386
## [57] 11.80052 11.79729 11.79417 11.79117 11.78828 11.78553 11.78290 11.78042
## [65] 11.77808 11.77589 11.77385 11.77198 11.77027 11.76873 11.76737 11.76596
## [73] 11.76428 11.76235 11.76019 11.75784 11.75530 11.75261 11.74980 11.74687
## [81] 11.74386 11.74080 11.73770 11.73458 11.73148 11.72841 11.72541 11.72248
## [89] 11.71966 11.71697 11.71444 11.71208 11.70992 11.70799 11.70631 11.70490
## [97] 11.70378 11.70298 11.70253 11.70244 11.70274 11.70345 11.70461 11.70622
## [105] 11.70832 11.71093 11.71400 11.71746 11.72131 11.72553 11.73011 11.73504
## [113] 11.74029 11.74586 11.75175 11.75792 11.76437 11.77110 11.77808 11.78530
## [121] 11.79275 11.80041 11.80828 11.81634 11.82458 11.83299 11.84155 11.85025
## [129] 11.85907 11.86801 11.87705 11.88618 11.89539 11.90637 11.92056 11.93754
## [137] 11.95689 11.97819 12.00103 12.02499 12.04964 12.07458 12.09937 12.12361
## [145] 12.14688 12.16875 12.18882 12.20665 12.22184 12.23762 12.25720 12.28015
## [153] 12.30600 12.33432 12.36464 12.39653 12.42953 12.46318 12.49706 12.53069
## [161] 12.56364 12.59545 12.62568 12.65387 12.67958 12.70236 12.72175 12.73731
## [169] 12.75069 12.76380 12.77664 12.78917 12.80138 12.81325 12.82476 12.83587
## [177] 12.84658 12.85686 12.86670 12.87606 12.88493 12.89328 12.90110 12.90837
## [185] 12.91505 12.92114 12.92661 12.93144 12.93561 12.93909 12.94187 12.94392
## [193] 12.94522 12.94576 12.94551 12.94444 12.94255 12.93980 12.93617 12.93165
## [201] 12.92622 12.91984 12.91251 12.90419 12.89487 12.88453 12.87315 12.86070
## [209] 12.84716 12.83251 12.81425 12.79037 12.76165 12.72885 12.69272 12.65403
## [217] 12.61353 12.57200 12.53019 12.48886 12.44877 12.41069 12.37537 12.34359
## [225] 12.31609 12.29364 12.27252 12.24875 12.22263 12.19451 12.16471 12.13357
## [233] 12.10140 12.06854 12.03531 12.00205 11.96909 11.93675 11.90537 11.87526
## [241] 11.84677 11.82021 11.79592 11.77423 11.75547 11.73896 11.72373 11.70964
## [249] 11.69656 11.68434 11.67284 11.66194 11.65148 11.64133 11.63136 11.62142
## [257] 11.61137 11.60109 11.59042 11.57923 11.56739 11.55638 11.54761 11.54083
## [265] 11.53577 11.53217 11.52976 11.52830 11.52750 11.52712 11.52689 11.52655
## [273] 11.52583 11.52448 11.52224 11.51883 11.51401 11.50750 11.49905 11.48839
## [281] 11.47700 11.46645 11.45660 11.44732 11.43848 11.42995 11.42158 11.41325
## [289] 11.40484 11.39619 11.38719 11.37769 11.36758 11.35670 11.34494 11.33216
## [297] 11.31897 11.30605 11.29335 11.28082 11.26841 11.25606 11.24372 11.23134
## [305] 11.21887 11.20626 11.19346 11.18041 11.16707 11.15338 11.13929 11.12475
## [313] 11.10970 11.09411 11.07791 11.06123 11.04422 11.02689 11.00925 10.99129
## [321] 10.97302 10.95445 10.93558 10.91640 10.89694 10.87718 10.85714 10.83682
## [329] 10.81622 10.79535 10.77420 10.75279 10.73111 10.70918 10.68699 10.66455
## [337] 10.64187 10.61894 10.59577 10.57237 10.54873 10.52487 10.50079 10.47648
## [345] 10.45196#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")